home *** CD-ROM | disk | FTP | other *** search
/ FishMarket 1.0 / FishMarket v1.0.iso / fishies / 051-075 / disk_075 / dum2 / src / dumisc.mod < prev    next >
Text File  |  1992-05-06  |  9KB  |  331 lines
  1. IMPLEMENTATION MODULE DuMisc;
  2.  
  3. (*$S-*)(*$T-*)(*$A+*)
  4. (*
  5.         This module has several miscellaneous procedures
  6.         and was separated to keep the main program from getting
  7.         more cluttered than it was. Someday I'll clean it all up.
  8.  
  9.         Written: 3/21/87 by Greg Browne
  10.  
  11.         Compiles on TDI's Modula-2 Compiler version 2.20a
  12.  
  13.  
  14. *)
  15.  
  16. FROM SYSTEM             IMPORT  ADR, NULL,ADDRESS,TSIZE;
  17. FROM Ports              IMPORT  ReplyMsg,GetMsg,MessagePtr;
  18. FROM DOSCodeLoader      IMPORT  Execute;
  19. FROM DOSFiles           IMPORT  Lock,Unlock,AccessRead,FileLock,Open, Close,
  20.                                 Read, Write, DeleteFile, Examine,Rename,
  21.                                 FileInfoBlock, IoErr, FileHandle,
  22.                                 AccessWrite,ModeNewFile, ModeOldFile;
  23. FROM DuTypefile         IMPORT  DisplayASCII,DisplayHex;
  24. FROM Conversions        IMPORT  ConvertToString;
  25. FROM Gadgets            IMPORT  RefreshGadgets,AddGadget,RemoveGadget;
  26. FROM Strings            IMPORT  Assign,Concat,Length,Insert;
  27. FROM Memory             IMPORT  AllocMem,FreeMem,MemReqSet,MemClear,MemPublic;
  28. FROM Intuition          IMPORT  IntuitionText;
  29. FROM DuWindow           IMPORT  GadgetNames,DuWindowPtr,DuGads,SlidePot,
  30.                                 IOStringInfo,IOString,NullReqPtr;
  31.  
  32. FROM DuDir              IMPORT  DirEntries,DirTable,QSort;
  33.  
  34. (* All defined in .def module to be exportable
  35. TYPE
  36.   CharPtr       = POINTER TO CHAR;
  37.  
  38. VAR
  39.   MyMsg         : IntuiMessagePtr;
  40.   MyClass       : IDCMPFlagSet;
  41.   MyGadPtr      : GadgetPtr;
  42.   OutHandle     : FileHandle;
  43.   GadGot        : GadgetNames;
  44.   MyX,MyY       : INTEGER;
  45.   Gp            : ARRAY[0..255] OF CHAR;
  46. *)
  47.  
  48. TYPE
  49.   FileInfoBlockPtr = POINTER TO FileInfoBlock;
  50.  
  51. VAR
  52.   Cp            : CharPtr;
  53. (* ================================*)
  54.  
  55. PROCEDURE CheckMessages():BOOLEAN;
  56. BEGIN
  57.   MyMsg := GetMsg(DuWindowPtr^.UserPort);
  58.   IF MyMsg = NULL THEN RETURN FALSE END;
  59.   MyClass := MyMsg^.Class;
  60.   MyX := MyMsg^.MouseX;
  61.   MyY := MyMsg^.MouseY;
  62.   MyGadPtr := MyMsg^.IAddress;
  63.   ReplyMsg(MessagePtr(MyMsg));
  64.   GadGot := GadgetNames(MyGadPtr^.GadgetID);
  65.   RETURN TRUE;
  66. END CheckMessages;
  67.  
  68. PROCEDURE FillGpto(VAR a,b:ARRAY OF CHAR);
  69. BEGIN
  70.   Insert(" to ",Gp,0);
  71.   Insert(b,Gp,0);
  72.   Insert(a,Gp,0);
  73.   ReplaceRSDM(msg,Gp);
  74. END FillGpto;
  75.  
  76.  
  77. PROCEDURE AddNameToPath(VAR name,path:ARRAY OF CHAR);
  78. (* Second name is a path with no filename, first is filename to add *)
  79. BEGIN
  80.   Assign(Gp,path);
  81.   IF (Gp[Length(path)-1] <> ":") THEN Concat(Gp,"/",Gp) END;
  82.   Concat(Gp,name,Gp);
  83. END AddNameToPath;
  84.  
  85.  
  86. PROCEDURE DoFileLook():BOOLEAN;
  87. VAR s: BOOLEAN; i:CARDINAL ;g:GadgetNames;
  88.     l: FileLock;
  89. BEGIN
  90.   g := GadGot;
  91.   FOR i := 1 TO DirEntries DO
  92.     IF CheckMessages() THEN RETURN TRUE END;
  93.     WITH DirTable[i]^ DO
  94.       IF (IsSelected) AND (NOT IsDir) THEN
  95.         s := FALSE;
  96.         IF (g = htype) OR (g = type) THEN s := TRUE END;
  97.         l := Lock(FileName,AccessRead);
  98.         IF (l <> 0) THEN
  99.           Unlock(l);
  100.           IF (g = type) OR (g = print) THEN
  101.             DisplayASCII(FileName,s)
  102.           ELSE
  103.             DisplayHex(FileName,s)
  104.           END;
  105.           WasSelected := TRUE;
  106.           IsSelected := FALSE;
  107.         END
  108.       END
  109.     END
  110.   END;
  111.   RETURN FALSE;
  112. END DoFileLook;
  113.  
  114.  
  115. PROCEDURE DuCopy(VAR from,into:ARRAY OF CHAR):LONGINT;
  116. VAR  fhand,tohand:FileHandle;siz:CARDINAL;er,ex:LONGINT;
  117.     ad:ADDRESS;
  118. BEGIN
  119.   ex := LONGINT(0);
  120.   siz := 4000H;
  121.   AddNameToPath(from,into);
  122.   fhand := Open(from,ModeOldFile);
  123.   IF fhand = 0 THEN RETURN IoErr() END;
  124.   tohand := Open(Gp,ModeNewFile);
  125.   IF tohand = 0 THEN
  126.     er := IoErr();
  127.     Close(fhand);
  128.     RETURN er;
  129.   END;
  130.   REPEAT
  131.     ad := AllocMem(LONGCARD(siz),MemReqSet{MemPublic,MemClear});
  132.     IF ad = NULL THEN siz := siz DIV 2 END;
  133.   UNTIL (ad # NULL) OR (siz < 512);
  134.   IF ad = NULL THEN
  135.     Close(fhand);
  136.     Close(tohand);
  137.     RETURN LONGINT(-3)
  138.   END;
  139.   FillGpto("Copying ",from);
  140.   REPEAT
  141.     er := Read(fhand,ad,LONGCARD(siz));
  142.     IF er > 0 THEN er := Write(tohand,ad,LONGCARD(er)) ELSE ex := IoErr() END;
  143.   UNTIL (er <> LONGINT(siz));
  144.   Close(fhand);
  145.   Close(tohand);
  146.   FreeMem(ad,LONGCARD(siz));
  147.   RETURN ex;
  148. END DuCopy;
  149.  
  150.  
  151. PROCEDURE CheckDestination():BOOLEAN;
  152. (* checks to see that IOString[dest] is a valid path without name *)
  153. VAR l : FileLock; IsOrNot:BOOLEAN; m:FileInfoBlockPtr;
  154. BEGIN
  155.  IsOrNot := FALSE; (* Assume not ok *)
  156.  l := Lock(IOString[dest],AccessRead);
  157.  IF l = 0 THEN RETURN IsOrNot END;
  158.  m := AllocMem(TSIZE(FileInfoBlock),MemReqSet{MemPublic,MemClear});
  159.  IF (m # NULL) THEN
  160.    IF Examine(l,m^) AND (m^.fibDirEntryType > 0) THEN IsOrNot := TRUE END;
  161.  END;
  162.  Unlock(l);
  163.  FreeMem(m,TSIZE(FileInfoBlock));
  164.  RETURN IsOrNot;
  165. END CheckDestination;
  166.  
  167. PROCEDURE BlankName(VAR name:ARRAY OF CHAR);
  168. BEGIN
  169.   name[0] := 177C;
  170.   name[1] := 177C;
  171.   name[2] := 0C;
  172. END BlankName;
  173.  
  174.  
  175. PROCEDURE DuMoveFile(VAR name,name2:ARRAY OF CHAR):LONGINT;
  176. (* Returns IoErr or 0 *)
  177. BEGIN
  178.   IF Rename(name,name2) THEN
  179.     BlankName(name);
  180.     RETURN LONGINT(0)
  181.   END;
  182.   RETURN IoErr();
  183. END DuMoveFile;
  184.  
  185.  
  186. PROCEDURE DuDelete(VAR name:ARRAY OF CHAR):LONGINT;
  187. (* Returns IoErr or 0 *)
  188. BEGIN
  189.   Assign(Gp,"Deleting ");
  190.   Concat(Gp,name,Gp);
  191.   ReplaceRSDM(msg,Gp);
  192.   IF DeleteFile(name) THEN
  193.     BlankName(name);
  194.     RETURN LONGINT(0);
  195.   END;
  196.   RETURN IoErr();
  197. END DuDelete;
  198.  
  199.  
  200. PROCEDURE DuFileTwiddle(WithCopy,WithDelete:BOOLEAN):LONGINT;
  201. (* Returns IoErr *)
  202. VAR i:CARDINAL ;g:GadgetNames;
  203.     from,to: FileLock;er:LONGINT;temp:ARRAY[0..30] OF CHAR;
  204. BEGIN
  205.   g := GadGot;
  206.   IF (NOT CheckDestination()) AND WithCopy THEN RETURN LONGINT(-1) END;
  207.   FOR i := 1 TO DirEntries DO
  208.     IF CheckMessages() THEN RETURN LONGINT(-2) END;
  209.     WITH DirTable[i]^ DO
  210.       IF (IsSelected) AND (NOT IsDir) THEN
  211.         from := Lock(FileName,AccessRead);
  212.         IF (from <> 0) THEN
  213.           Unlock(from);
  214.           IF (NOT WithCopy) AND (NOT WithDelete) THEN
  215.              Assign(temp,FileName);
  216.              AddNameToPath(FileName,IOString[dest]);
  217.              er := DuMoveFile(FileName,Gp);
  218.              IF (er <> 0) THEN RETURN er
  219.               ELSE FillGpto("Moved ",temp);
  220.              END;
  221.           END;
  222.           IF WithCopy THEN
  223.             er := (DuCopy(FileName,IOString[dest]));
  224.             IF (er <> 0)  THEN RETURN er END;
  225.           END;
  226.           IF WithDelete THEN
  227.             er := DuDelete(FileName);
  228.             IF (er <> 0) THEN RETURN er END;
  229.           ELSE
  230.             WasSelected := TRUE;
  231.             IsSelected := FALSE;
  232.           END
  233.         END
  234.       END
  235.     END
  236.   END;
  237.   RETURN LONGINT(0);
  238. END DuFileTwiddle;
  239.  
  240. PROCEDURE DoIt(WRun:BOOLEAN;VAR a,b,c,d:ARRAY OF CHAR);
  241. BEGIN
  242.   IF WRun THEN Assign(Gp,"RUN >NIL: ") ELSE Gp := "" END;
  243.   Concat(Gp,a,Gp);
  244.   Concat(Gp," ",Gp);
  245.   Concat(Gp,b,Gp);
  246.   Concat(Gp," ",Gp);
  247.   Concat(Gp,c,Gp);
  248.   IF (d[0] > 0C) THEN
  249.     Concat(Gp,' "',Gp);
  250.     Concat(Gp,d,Gp);
  251.     Concat(Gp,'"',Gp);
  252.   END;
  253.   IF Execute(Gp,FileHandle(0),OutHandle) THEN END;
  254. END DoIt;
  255.  
  256. PROCEDURE TryIt(g:GadgetNames;VAR Name:ARRAY OF CHAR);
  257. BEGIN
  258.   CASE g OF
  259.     arc   : DoIt(FALSE,"ARC ",IOString[run],IOString[dest],Name);|
  260.     edit  : DoIt(FALSE,"MEmacs  ","","",Name);                 |
  261.     runfr : DoIt(TRUE,  Name,"","",IOString[run]);             |
  262.     runrf : DoIt(TRUE,  IOString[run],"","",Name);             |
  263.     show  : DoIt(FALSE,"SHOW    ","","",Name);                 |
  264.     execfr: DoIt(FALSE, Name,IOString[run],"","");             |
  265.     execrf: DoIt(FALSE, IOString[run],Name,"","");
  266.   ELSE
  267.   END;
  268. END TryIt;
  269.  
  270. PROCEDURE DuExec():LONGINT;
  271. VAR s: BOOLEAN; i:CARDINAL ;g:GadgetNames;
  272.     l: FileLock;
  273. BEGIN
  274.   g := GadGot; s:= FALSE;
  275.   FOR i := 1 TO DirEntries DO
  276.     IF CheckMessages() THEN RETURN LONGINT(-2) END;
  277.     WITH DirTable[i]^ DO
  278.       IF (IsSelected) THEN
  279.         IF (NOT IsDir) OR (g = execrf) THEN
  280.           s := TRUE;
  281.           TryIt(g,FileName);
  282.           IsSelected := FALSE;
  283.           WasSelected := TRUE;
  284.         END;
  285.       END;
  286.     END;
  287.   END;
  288.   IF (s = FALSE) THEN
  289.     IF (g = execfr) OR (g=execrf) THEN
  290.       TryIt(g,"")
  291.     ELSIF (g <> show) THEN
  292.       TryIt(g,"");
  293.     END;
  294.   END;
  295.   RETURN LONGINT(0);
  296. END DuExec;
  297.  
  298.  
  299. PROCEDURE ReplaceRSDM(g:GadgetNames;VAR a:ARRAY OF CHAR);
  300. VAR VAR d:INTEGER;
  301. BEGIN
  302.   d := RemoveGadget(DuWindowPtr,DuGads[g]);
  303.   Assign(IOString[g],a);
  304.   IF g = msg THEN Insert(" ",IOString[g],0) END;
  305.   IOStringInfo[g].NumChars := Length(IOString[g]);
  306.   IOStringInfo[g].BufferPos := Length(IOString[g]);
  307.   d := AddGadget(DuWindowPtr,DuGads[g],d);
  308.   RefreshGadgets(DuGads[g],DuWindowPtr,NullReqPtr^);
  309. END ReplaceRSDM;
  310.  
  311.  
  312. PROCEDURE StringIt(n:LONGCARD;VAR s:ARRAY OF CHAR):BOOLEAN;
  313. VAR Okay:BOOLEAN;
  314. BEGIN
  315.   ConvertToString(ABS(n),10,FALSE,s,Okay);
  316.   RETURN Okay
  317. END StringIt;
  318.  
  319.  
  320. PROCEDURE AskForConfirm;
  321. BEGIN
  322.   ReplaceRSDM(msg,"Click same GADGET again to DO IT! (Anything else cancels)");
  323. END AskForConfirm;
  324.  
  325. (********)
  326. (* MAIN *)
  327. (********)
  328.  
  329. BEGIN
  330. END DuMisc.
  331.